home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
vis082s.arc
/
MAINR2.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-17
|
7KB
|
274 lines
{$R-,S-,I-,D-,F+,V-,B-,N-,L+ }
unit mainr2;
interface
uses Dos,crt,gensubs,gentypes,modem,subs1,subs2,statret,configrt,overret1,
textret,userret,mailret,lineedit,ansiedit,mainr1;
function reedit (var m:message; g:boolean):boolean;
function editor (var m:message; sendto,gettitle:boolean; sent,bs:mstr):integer;
procedure seekbdfile (n:integer);
procedure writebdfile (var bd:boardrec);
procedure writecurboard;
(*procedure addnews;*)
procedure sendmailto (uname:mstr; anon:boolean);
procedure addfeedback (var m:mailrec);
procedure hangupmodem;
procedure setupmodem;
procedure disconnect;
implementation
function reedit (var m:message; g:boolean):boolean;
begin
if fseditor in urec.config
then reedit:=ansireedit (m,g)
else reedit:=linereedit (m,g);
trimmessage (m)
end;
procedure seekbdfile (n:integer);
begin
seek (bdfile,n);
seek (bifile,n); che
end;
procedure writebdfile (var bd:boardrec);
begin
write (bdfile,bd);
write (bifile,bd.shortname)
end;
procedure writecurboard;
begin
seekbdfile (curboardnum);
writebdfile (curboard); che
end;
function uploadmsg:integer;
var f:text;
b:bulrec;
tu:mstr;
me:message;
sub,ls:lstr;
lne:integer;
begin
uploadmsg:=-2;
If yes then Begin
If local then Begin
buflen:=80;
writestr ('Enter Name and Path to Text File:');
if length(input)<1 then exit;
assign (f,input);
reset (f);
if ioresult <> 0 then begin
writeln ('Cannot find Specified File!');
exit
end;
end else begin
writeln(^M^S'Ready to receive via Z-Modem Upload!');
assign(f,configset.forumdi+'Message.Xyz');
if exist(configset.forumdi+'Message.Xyz') then erase(f);
delay(500);
exec('DSZ.COM',' port '+strr(configset.useco)+' speed '+strlong(baudrate)+' rz '+configset.forumdi+'Message.Xyz');
if dosexitcode<>0 then begin
writeln(^G^G'Aborted!');
if exist(configset.forumdi+'Message.Xyz') then erase(f);
exit;
end;
end;
lne:=0;
reset(f);
while not eof(f) do begin
readln(f,ls);
inc(lne);
if lne>100 then begin
Writeln(^G^G^S'You may NOT have more then 100 lines in a message!');
textclose(f);
if not local then erase(f);
exit;
end;
me.text[lne]:=ls;
end;
me.anon:=false;
me.numlines:=lne;
me.note:=urec.usernote;
if me.numlines < 1 then begin
writeln (^R'Message not saved!');
exit;
end;
b.line:=maketext(me);
uploadmsg:=b.line;
b.anon:=false;
B.Where:=Configset.origin1;
B.Where2:=Configset.origin2;
B.Version:=NetMailVer;
B.Cnet:=False;
B.FidoNet:=False;
B.Flag3:=False;
B.Flag4:=False;
B.Flag5:=False;
B.Flag6:=False;
B.Flag7:=False;
B.Flag8:=False;
B.RealName:=Urec.RealName;
b.when:=now;
b.leftby:=unam;
b.status:='[ ha ]';
b.recieved:=false;
b.leftto:=tu;
b.line:=lne;
b.plevel:=ulvl;
(* addbul(b);
inc(newposts);
inc(gnup);
with curboard do if autodel<=numbuls then autodelete; *)
writeln(^M^S'Message has been saved');
end;
End;
function editor (var m:message; sendto,gettitle:boolean; sent,bs:mstr):integer;
var post:boolean;
function getthetitle:boolean;
begin
post:=true;
m.anon:=false;
getthetitle:=true;
If okfortitle then begin
buflen:=40;
writestr (^M^P'Title'^R':');
if length(input)=0 then begin
getthetitle:=false;
exit
end;
m.title:=input;
End;
okfortitle:=True;
if gettitle then begin
buflen:=30;
if sendto and (length(sent)=1) then begin
writestr(^M^M^P'Send to ['^R'CR/All'^P']:');
if length(input)=0 then m.sendto:='All'
else
m.sendto:=input;
end else m.sendto:='The SysOp''s';
if bs='EMAIL' then begin
m.title:='Announcement';
m.sendto:=urec.handle;
exit;
end;
if sent<>'0' then m.sendto:=sent;
if bs<>'0' then begin
m.title:=bs;
exit;
end;
if ulvl>=configset.anonymousleve then begin
buflen:=1;
writestr ('Anonymous? *');
m.anon:=yes
end;
writestr ('Upload a Prepared Message? *');
if yes then begin
editor:=uploadmsg;
post:=false;
end;
end;
end;
var b:boolean;
begin
{ If useansiup then Begin }
editor:=-1;
m.numlines:=0;
m.note:=urec.usernote;
if not sendto then begin
m.sendto:='All';
m.title:='Message to next user';
end;
if match(bs,'EMAIL') then m.title:='Announcement';
b:=getthetitle;
if not post then exit;
if b then if
reedit(m,gettitle) then
editor:=maketext(m)
{ end;
useansiup:=false; }
end;
procedure sendmailto (uname:mstr; anon:boolean);
var un:integer;
me:message;
line:integer;
u:userrec;
begin
if length(uname)=0 then exit;
un:=lookupuser (uname);
if un=0 then writeln ('User not found.') else begin
if anon and (ulvl<configset.sysopleve) then uname:=configset.anonymousst;
seek (ufile,un);
read (ufile,u);
if u.emailannounce>-1 then begin
writehdr (u.handle+'''s Announcement');
printtext (u.emailannounce)
end;
writehdr ('Sending mail to '+uname);
line:=editor(me,false,true,uname,'0');
if line>=0 then addmail (un,line,me)
end
end;
procedure addfeedback (var m:mailrec);
var ffile:file of mailrec;
begin
assign (ffile,configset.forumdi+'Feedback');
reset (ffile);
if ioresult<>0 then begin
close (ffile);
rewrite (ffile)
end;
seek (ffile,filesize(ffile));
write (ffile,m);
close (ffile);
newfeedback:=newfeedback+1;
end;
procedure hangupmodem;
var tries:integer;
begin
tries:=0;
while carrier and (tries<5) do begin
delay(500);
hangup;
tries:=tries+1
end;
setparam (configset.useco,baudrate,parity)
end;
procedure setupmodem;
begin
write(direct,#27,'[0m');
if carrier then exit;
writeln (usr,^M^J'Setting up the modem...'^M^J^J);
sendmodemstr (configset.modemsetupst,true);
end;
procedure disconnect;
begin
if online then hangupmodem;
online:=true;
writelog (0,3,'');
if (unum>0) and not disconnected then updateuserstats (true);
disconnected:=true;
forcehangup:=true;
writestatus;
hangup
end;
begin
end.